home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / pulldwn.arc / PULLDOWN.PAS < prev    next >
Pascal/Delphi Source File  |  1987-01-24  |  11KB  |  313 lines
  1. {$I c:\turbo\qwik\qwik21.inc}
  2. {$I c:\turbo\qwik\window31.inc}
  3. (*************************************************************************)
  4. (* THIS PROGRAM ILLUSTRATES THE USE OF PULLDOWN MENUS.  IT USES BOTH     *)
  5. (* QWIK21 AND WINDOW30 ROUTINES FOR ALL OF THE FAST SCREEN WRITING.      *)
  6. (* THIS PROGRAM WAS WRITTEN BY ART HILL AND BROUGHT OUT UNDER THE        *)
  7. (* TEAMWARE CONCEPT.  SEE THE ACCOMPANYING DOCUMENTATION.                *)
  8. (*************************************************************************)
  9.  
  10. (*            PULLDOWN.INC                                               *)
  11. (*            Version 1.0  Copyright 1986  by Art Hill                   *)
  12. (*            Released under the TEAMWARE concept                        *)
  13.    Type
  14.       {EACH PULLDOWN MENU IS REPRESENTED BY ONE OF THE FOLLOWING RECORDS}
  15.       {THE ARRAY HOLDS THE "TITLE" OF THE MENU IN POSITION 0 AND THE    }
  16.       {INDIVIDUAL SELECTIONS IN POSITIONS 1..15.  NUMSUBS REFERS TO THE }
  17.       {NUMBER OF CHOICES FOR THAT PULLDOWN MENU AND HILITE REFERS TO    }
  18.       {WHICH ONE IS CURRENTLY CHOSEN OR "SET"}
  19.       menus=Record
  20.                txt:Array[0..15] Of String[20];
  21.                numsubs:Byte;
  22.                hilite:1..15;
  23.             End;
  24.       choice=Array[1..8] Of menus;
  25.       keyvalues=Record
  26.                    chval:Char;
  27.                    ascval:0..255;
  28.                    scanval:0..255;
  29.                 End;
  30.  
  31.       chrset=Set Of Char;
  32.    Var
  33.       j,oldcursor,normattrib:Integer;
  34.       extkey:Boolean;
  35.       tempstr:str80;
  36.       bk_color,fg_color:Integer;
  37.       st_background,esc,null,rspchr,ret:Char;
  38.       lastkey:keyvalues;
  39.       f1key,f2key,f3key,f4key,f5key,f6key,f7key,f8key,
  40.       f9key,f10key,pgup,pgdn,homekey,endkey,cursorup,cursordn,
  41.       cursorlf,cursorrt,inskey,delkey,shtabkey,tabkey,backsp:Char;
  42.       errnum:Integer;
  43.       trash:Integer;
  44.       tab:Char;
  45.  
  46.    Function roll(curval:Integer;up:Boolean;min,max:Integer):Integer;
  47.          {INCREMENTS A NUMBER UP OR DOWN, ROLLING AROUND MINIMUM OR MAXIMUM}
  48.       Begin
  49.          If up Then
  50.             If curval<max Then
  51.                curval:=curval+1
  52.             Else curval:=min
  53.          Else
  54.             If curval>min Then
  55.                curval:=curval-1
  56.             Else curval:=max;
  57.          roll:=curval;
  58.       End;
  59.  
  60.    Procedure getkb(Var ch:Char;Var ascii,scan:Byte);
  61.       Type regpack=Record
  62.                       ax,bx,cx,dx,bp,si,ds,es,flags:Integer;
  63.                    End;
  64.       Var reg:regpack;
  65.  
  66.       Begin
  67.          reg.ax:=0;
  68.          Intr($16,reg);
  69.          ascii:=Lo(reg.ax);
  70.          scan:=Hi(reg.ax);
  71.          ch:=Char(ascii);
  72.          With lastkey Do
  73.             Begin
  74.                ascval:=ascii;
  75.                scanval:=scan;
  76.                If scanval>58 Then
  77.                   Begin
  78.                      ascval:=scanval+100;{adjust ascii value for extended codes
  79.                                           to putthem above 128}
  80.                      extkey:=True;
  81.                   End;
  82.                chval:=Char(ascval);
  83.             End;
  84.       End;
  85.  
  86.    Function getkey(Var ch:Char;valid:chrset;shiftlock:Boolean):Char;
  87.       Var
  88.          ok:Boolean;
  89.          ascii,scan:Byte;
  90.       Begin
  91.          { GETKEY }
  92.         Repeat
  93.             extkey:=False;
  94.             getkb(ch,ascii,scan);
  95.             ch:=lastkey.chval;
  96.             If (shiftlock) And (ch In ['a'..'z']) Then
  97.                ch:=Chr(Ord(ch)-32);
  98.             ok:=ch In valid;
  99.             If Not ok Then
  100.                Write(#7);
  101.          Until ok;
  102.          getkey:=ch;
  103.       End;{OF GETKEY}
  104.  
  105.  
  106.    Function attribute(foreground,background:Byte):Byte;
  107.          {-translates foreground and background colors into video attributes.
  108.          "and 127" masks out the blink bit. add 128 to the result to set it.}
  109.       Begin
  110.          attribute:=((background Shl 4)+foreground) And 127;
  111.       End;
  112.  
  113.    Procedure setborder(color:Byte);
  114.  
  115.       Begin
  116.          Port[$03d9]:=color;
  117.       End;
  118.  
  119.    Procedure pulldown_menus(Var choices:choice;
  120.                              no_of_items,defaultitem,col,row:Integer;
  121.                              Var at_which:Integer;Var tchar:Char);
  122.  
  123.       Var
  124.          c,trash,next,previous:Integer;
  125.          colstart:Array[1..8] Of Integer;
  126.          keytyped:Char;
  127.          firstletters:Array[1..8] Of Char;
  128.          validletters:Set Of Char;
  129.          match:Boolean;
  130.       Procedure showpulldown(whichone:Byte);
  131.          Begin
  132.             makewindow(row+1,colstart[whichone],choices[whichone].numsubs+2,
  133.             17,15,1,7,1,solid);
  134.  
  135.             With choices[whichone] Do
  136.                Begin
  137.                   For trash:=1 To numsubs Do
  138.                      qwritev(row+1+trash,colstart[whichone]+2,-1,txt[trash]);
  139.                End;
  140.             With choices[whichone] Do
  141.                qattr(row+1+hilite,colstart[whichone]+1,1,15,112);
  142.          End;
  143.       Begin
  144.          cursorchange(8192,oldcursor);
  145.          validletters:=[];
  146.          colstart[1]:=col;
  147.          For trash:=2 To no_of_items Do
  148.             Begin
  149.                colstart[trash]:=
  150.                (colstart[trash-1]+3+Length(choices[trash-1].txt[0]));
  151.             End;
  152.          For trash:=1 To no_of_items Do
  153.             Begin
  154.                firstletters[trash]:=choices[trash].txt[0][1];
  155.                validletters:=validletters+[firstletters[trash]];
  156.                qwritev(row,colstart[trash],normattrib,choices[trash].txt[0]);
  157.             End;
  158.          qwritev(row,colstart[defaultitem],attribute(0,7),choices[
  159.          defaultitem].txt[0]);
  160.          showpulldown(defaultitem);
  161.          at_which:=defaultitem;
  162.          While Not(getkey(keytyped,[Chr(13),Chr(32),f10key,Chr(27),
  163.                     cursorrt,pgdn,pgup,homekey,cursorup,cursordn,cursorlf,
  164.                     f1key]+validletters,True) In
  165.                    [Chr(13),Chr(27),Chr(32),f10key,pgdn,pgup,homekey,f1key]) Do
  166.             Begin
  167.                If (at_which<no_of_items) Then
  168.                   Begin
  169.                      next:=Succ(at_which);
  170.                   End
  171.                Else
  172.                   next:=1;
  173.                If at_which>1 Then
  174.                   Begin
  175.                      previous:=Pred(at_which)
  176.                   End
  177.                Else
  178.                   previous:=no_of_items;
  179.                c:=1;
  180.                match:=False;
  181.                If keytyped In validletters Then
  182.                   Repeat
  183.                      If keytyped=firstletters[c] Then
  184.                         Begin
  185.                            qwritev(row,colstart[at_which],attribute(fg_color,
  186.                            bk_color),
  187.                            choices[at_which].txt[0]);
  188.                            at_which:=c;
  189.                            qwritev(row,colstart[at_which],attribute(0,7),
  190.                                choices[
  191.                            at_which].txt[0]);
  192.                            match:=True;
  193.                         End;
  194.                      c:=c+1;
  195.                   Until match=True
  196.                Else Case keytyped Of
  197.                   #175:Begin
  198.                           qwritev(row,colstart[at_which],attribute(fg_color,
  199.                                   bk_color),
  200.                           choices[at_which].txt[0]);
  201.                           qwritev(row,colstart[previous],attribute(0,7),
  202.                           choices[previous].txt[0]);
  203.                           at_which:=previous;
  204.                           removewindow;
  205.                           showpulldown(at_which);
  206.                        End;
  207.                   #177:Begin
  208.                           qwritev(row,colstart[at_which],attribute(fg_color,
  209.                                   bk_color),
  210.                           choices[at_which].txt[0]);
  211.                           qwritev(row,colstart[next],attribute(0,7),choices[
  212.                                   next].txt[0]);
  213.                           at_which:=next;
  214.                           removewindow;
  215.                           showpulldown(at_which);
  216.                        End;
  217.                   #172:With choices[at_which] Do
  218.                           Begin
  219.                              qattr(row+1+hilite,colstart[at_which]+1,1,15,
  220.                                    normattrib);
  221.                              hilite:=roll(hilite,False,1,numsubs);
  222.                              qattr(row+1+hilite,colstart[at_which]+1,1,15,112);
  223.                           End;
  224.                   #180:With choices[at_which] Do
  225.                           Begin
  226.                              qattr(row+1+hilite,colstart[at_which]+1,1,15,
  227.                                    normattrib);
  228.                              hilite:=roll(hilite,True,1,numsubs);
  229.                              qattr(row+1+hilite,colstart[at_which]+1,1,15,112);
  230.                           End;
  231.                End;{OF CASE}
  232.             End;{OF WHILE LOOP}
  233.          tchar:=keytyped;
  234.          cursorchange(oldcursor,trash);
  235.          removewindow;
  236.       End;{OF PROCEDURE HORIZ_WHICHITEM }
  237.  
  238.    Procedure misc_init;
  239.       Begin{ MISC INITIALIZATION }
  240.          trash:=0;
  241.          esc:=Chr(27);
  242.          null:=Chr(0);
  243.          ret:=Chr(13);
  244.          f1key:=Chr(159);
  245.          f2key:=Chr(160);
  246.          f3key:=Chr(161);
  247.          f4key:=Chr(162);
  248.          f5key:=Chr(163);
  249.          f6key:=Chr(164);
  250.          f7key:=Chr(165);
  251.          f8key:=Chr(166);
  252.          f9key:=Chr(167);
  253.          f10key:=Chr(168);
  254.          cursorlf:=Chr(175);
  255.          cursorrt:=Chr(177);
  256.          cursorup:=Chr(172);
  257.          cursordn:=Chr(180);
  258.          homekey:=Chr(171);
  259.          endkey:=Chr(179);
  260.          pgup:=Chr(173);
  261.          pgdn:=Chr(181);
  262.          inskey:=Chr(182);
  263.          delkey:=Chr(183);
  264.          tabkey:=Chr(9);
  265.          tab:=Chr(9);
  266.          shtabkey:=Chr(15);
  267.          backsp:=Chr(8);
  268.          bk_color:=1;
  269.          fg_color:=15;
  270.          TextColor(fg_color);
  271.          TextBackground(bk_color);
  272.          qinit;
  273.          normattrib:=attribute(fg_color,bk_color);
  274.       End;{ OF INITIALIZATION }
  275.  
  276. (*                    END OF PULLDOWN.INC                         *)
  277.  
  278.    Var picks:choice;
  279.       which:Integer;
  280.       tchar:Char;
  281.    Begin
  282.       qinit;
  283.       initwindow(15,1);
  284.       misc_init;
  285.       picks[1].txt[0]:='files';
  286.       picks[2].txt[0]:='printing';
  287.       picks[3].txt[0]:='parameters';
  288.       picks[4].txt[0]:='set up';
  289.       picks[5].txt[0]:='other';
  290.       picks[6].txt[0]:='defaults';
  291.       picks[7].txt[0]:='quit';
  292.       For trash:=1 To 7 Do
  293.          picks[trash].numsubs:=trash+3;
  294.       For trash:=1 To 7 Do
  295.          picks[trash].hilite:=trash+1;
  296.       picks[1].numsubs:=10;
  297.       For j:=1 To 7 Do
  298.          For trash:=1 To 10 Do
  299.             Begin
  300.                Str(trash,tempstr);
  301.                picks[j].txt[trash]:='choice '+tempstr;
  302.             End;
  303.       qfill(1,1,25,80,normattrib,' ');
  304.       which:=1;
  305.       Repeat
  306.          pulldown_menus(picks,7,which,1,1,which,tchar);
  307.          qfill(22,1,1,80,-1,' ');
  308.          gotorc(22,5);
  309.          Write('you chose ',picks[which].hilite,' from menu ',which,'(',
  310.          picks[which].txt[0],')');
  311.       Until which=7;
  312.    End.
  313.